perm filename GOMEZ.SAI[TMP,LCS]1 blob sn#133872 filedate 1974-07-05 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00004 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	BEGIN "ARMY"
C00004 00003	SIMPLE REAL PROCEDURE ANGL(INTEGER B1,A1,B2,A2)
C00009 00004	SUBR COMND
C00013 ENDMK
C⊗;
BEGIN "ARMY"
	REQUIRE "GEOMES.HDR[GEM,HE]" SOURCE_FILE;
	DEFINE π="3.1415927";
	DEFINE SUBR="SIMPLE PROCEDURE";
	DEFINE ISUBR="SIMPLE INTEGER PROCEDURE";
	DEFINE THRU="STEP 1 UNTIL";
	DEFINE ⊂="BEGIN";
	DEFINE ⊃="END";
	EXTERNAL SIMPLE REAL PROCEDURE ACOS(REAL W);
	INTEGER FRATE,CHR,GRAV,TAKE,IP,X,Y,Z;
	REAL NR,NT;STRING STR;
SUBR INIT;
BEGIN "INIT"
	MKUNIV;GEODPY;
	X ← 0;Y ← 3;Z ← 6;
	IP ← 0;TAKE ← 1;
	FRATE ← 20;
	OUTSTR("   FRATE =");STR ← INCHWL;
	IF LENGTH(STR)≠0 THEN FRATE ← INTSCAN(STR,CHR);
	NT ← 1.0/FRATE;NR ← NT*π;GRAV ← 32*NT;
END "INIT";
SIMPLE REAL PROCEDURE ANGL(INTEGER B1,A1,B2,A2);
BEGIN "ANGL"
	REAL ANG;
	IF B1<0 THEN B1 ← -B1;
	B1 ← A1+LOCOR(B1);
	B2 ← A2+LOCOR(B2);
	ANG ← ACOS(IX(B1)*IX(B2)+IX(B1+1)*
	IX(B2+1)+IX(B1+2)*IX(B2+2));
	RETURN(ANG);
END "ANGL";
ISUBR BUMP(INTEGER B1,B2,AX1,AX2;REAL MINA,MAXA,SP);
BEGIN "BUMP"
	INTEGER STP;
	REAL ANG;
	ANG ← SP+ANGL(B1,AX1,B2,AX2);
	IF ANG<MINA∨ANG>MAXA THEN STP ← -1
	ELSE STP ← 0;
	RETURN(STP);
END "BUMP";
ISUBR BEND(REFERENCE INTEGER BAC;INTEGER BD1,BD2,AR1,AR2,AR3;
	   REAL MN,MX,SP);
BEGIN "BEND"
	INTEGER PAST;
	REAL RO,RX,RY,RZ,AG;
	PAST ← -1;
	SP ← NR*SP;RO ← SP;
	IF BAC>1 THEN SP ← -SP;
	IF BAC>2 THEN ⊂ IF BAC=3 THEN RETURN(PAST);
		AG ← ANGL(BD1,AR2,BD2,AR3);
		IF AG<AG+SP THEN ⊂ BAC ← 3;RETURN(PAST);⊃;⊃;
	IF BUMP(BD1,BD2,AR2,AR3,MN,MX,SP) THEN BEGIN
	  IF BAC THEN BEGIN
	    IF BAC>0 THEN ⊂ BAC ← 3;RETURN(PAST);⊃;
	    RO ← -RO;
	    END;
	  END
	ELSE PAST ← 0;
	RX ← RY ← RZ ← 0;
	CASE AR1 OF ⊂ [0] RX ← RO;[3] RY ← RO;[6] RZ ← RO ⊃;
	ROTATE(BD1,RX,RY,RZ);
	RETURN(PAST);
END "BEND";
SIMPLE REAL PROCEDURE ANGLE(INTEGER B1,A1,N1);
BEGIN "ANGLE"
	INTEGER O1;
	REAL DIS,AN;
	O1 ← LOCOR(B1);DIS ← DISTAN(N1,O1);O1 ← O1+A1;
	AN ← ACOS(IX(O1)*((XWC(B1)-XWC(N1))/DIS)+IX(O1+1)*
	((YWC(B1)-YWC(N1))/DIS)+IX(O1+2)*((ZWC(B1)-ZWC(N1))/DIS));
	RETURN(AN);
END "ANGLE";
SIMPLE REAL PROCEDURE RBDEL(INTEGER B1,A1,B2,A2;REAL DV);
BEGIN "RBDEL"
	REAL RB;
	RB ← ANGL(B1,A1,B2,A2)/DV;
	RETURN(RB);
END "RBDEL";
SIMPLE REAL PROCEDURE RODEL(INTEGER B1,A1,N1;REAL DV);
BEGIN "RODEL"
	REAL ROD;
	ROD ← ANGLE(B1,A1,N1)/DV;
	RETURN(ROD);
END "RODEL";
SIMPLE REAL PROCEDURE TDEL(INTEGER B1,N1;REAL DV);
BEGIN "TDEL"
	REAL TD;
	TD ← DISTAN(N1,LOCOR(B1))/DV;
	RETURN(TD);
END "TDEL";
SUBR PLOP;
BEGIN "PLOP"
	IF TAKE>0 THEN ⊂ IF TAKE>1 THEN SHOW2(0,1)
		       ELSE GEODPY;RETURN;⊃;
	IF TAKE<-1 THEN SHOW2(0,1) ELSE GEODPY;
	IP ← IP+1;
	OUTSTR(" FRAME "&CVS(IP));PLOTO("FRM."&CVS(IP));
END "PLOP";
SUBR COMND;
BEGIN "COMND"
	INTEGER LC;
WHILE TRUE DO
 BEGIN
	LC ← INCHRW;
	IF LC="G" THEN GEOMED;
 END;
END "COMND";
	OUTSTR(12&12&12&12&12);
	INIT;
	COMND;
END "ARMY";